home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / DumpIFF.f < prev    next >
Encoding:
FORTH Source  |  1992-01-03  |  4.5 KB  |  239 lines
  1. \ Used for examining IFF files.
  2. \
  3. \ Show contents of all chunks.
  4. \ Author: Phil Burk
  5. \ Copyright 1991 All Rights Reserved.
  6.  
  7. getmodule includes
  8. include? picture jiff:load_pic
  9. include? ANHD JANIM:ANIM.J
  10.  
  11. ANEW TASK-DumpIFF
  12.  
  13. decimal
  14.  
  15. : .BYTE ( byte -- , print as two digits )
  16.     s->d <# # #S #> type space
  17. ;
  18.  
  19. : ?STOP ( -- flag , true if user wants out )
  20.     ?terminal dup
  21.     IF
  22.         drop >newline
  23.         key drop \ from ?terminal
  24.         ." Hit 'Q' to QUIT, any other key to continue."
  25.         key cr
  26.         dup ascii q = swap ascii Q = or
  27.     THEN
  28. ;
  29.  
  30. variable DIF-DLTA-COUNT
  31. variable DIF-BODY-COUNT
  32. 256 constant DIF_PAD_SIZE
  33. create DIF-PAD DIF_PAD_SIZE allot 0 ,
  34.  
  35. : DUMP.DATA { addr size -- , dump showing offset into data }
  36.     >newline
  37.     base @ >r  $ 10 base !
  38. \
  39. \ print header
  40.     8 spaces
  41.     16 0
  42.     DO
  43.         i 3 .r
  44.     LOOP
  45.     cr
  46. \
  47. \ print data
  48.     size 16 / 1+ 0
  49.     DO
  50.         i 16 * dup 6 .r 3 spaces
  51.         addr +  ( address of next byte )
  52.         16 0
  53.         DO
  54.             dup c@ .byte
  55.             1+
  56.         LOOP
  57.         drop cr
  58.         ?stop IF iff-stop on LEAVE THEN
  59.     LOOP
  60.     r> base !
  61. ;
  62.     
  63. : DIF.DUMP.DATA { size chunkid -- }
  64.     size dif_pad_size >
  65.     IF
  66.         dif_pad_size -> size ." Only showing part of "
  67.         chunkid .chkid ."  chunk!" cr
  68.     THEN
  69.     dif-pad size iff.read size -
  70.     IF
  71.         ." ANIM.DUMP.CHUNK - Truncated "
  72.         chunkid .chkid ."  chunk!" cr
  73.     THEN
  74.     dif-pad size dump.data
  75. ;
  76.  
  77. : DUMP.BMHD ( bitmapheader -- )
  78.     >r
  79.     >newline
  80.     ." X,Y     = " r@ s@ bmh_x . r@ s@ bmh_x . cr
  81.     ." W,H     = " r@ s@ bmh_w . r@ s@ bmh_h . cr
  82.     ." NPlanes = " r@ s@ bmh_nplanes . cr
  83.     ." Masking = " r@ s@ bmh_masking . cr
  84.     ." Compres = " r@ s@ bmh_compression . cr
  85.     ." TransColor = " r@ s@ bmh_transparentcolor . cr
  86.     ." Page W,H = " r@ s@ bmh_pagewidth .
  87.     r@ s@ bmh_pageheight . cr
  88.     rdrop
  89. ;
  90.  
  91. : DUMP.ANHD ( Animheader -- )
  92.     >r
  93.     >newline
  94.     ." Operatn = " r@ s@ ah_operation . cr
  95.     ." Mask    = " r@ s@ ah_mask  . cr
  96.     ." X,Y     = " r@ s@ ah_x . r@ s@ ah_x . cr
  97.     ." W,H     = " r@ s@ ah_w . r@ s@ ah_h . cr
  98.     ." ABSTime = " r@ s@ ah_abstime . cr
  99.     ." RELTime = " r@ s@ ah_reltime . cr
  100.     ." Interlv = " r@ s@ ah_interleave . cr
  101.     ." Bits    = " r@ s@ ah_bits . cr
  102.     ." Pad16:" cr r@ .. ah_pad16 16 dump.data
  103.     rdrop
  104. ;
  105.  
  106. : DUMP.DPAN ( DPAN_chunk -- , from Deluxe Paint, mysterious )
  107.     >r
  108.     >newline
  109.     ." Code    = " r@ s@ dp_code . cr
  110.     ." #Frames = " r@ s@ dp_frames  . cr
  111.     ." Rate    = " r@ s@ dp_rate . cr
  112.     ." Mode    = " r@ s@ dp_mode . cr
  113.     ." Dur (?) = " r@ s@ dp_dur . cr
  114.     rdrop
  115. ;
  116. : ANIM.DUMP.CHUNK { size chunkid -- , default handler used to parse }
  117.     chunkid
  118.     CASE
  119.         'BMHD'
  120.         OF
  121.             dif-pad size iff.read sizeof() BitMapHeader -
  122.             IF ." ANIM.DUMP.CHUNK - Oddly sized BitMapHeader!" cr
  123.             THEN
  124.             dif-pad dump.BMHD
  125.         ENDOF
  126.         'BODY'
  127.         OF
  128.             size chunkid dif.dump.data
  129.             1 dif-body-count +!
  130.         ENDOF
  131.         'CMAP'
  132.         OF
  133.             size dif_pad_size >
  134.             IF dif_pad_size -> size ." Only showing part of CMAP chunk!" cr
  135.             THEN
  136.             dif-pad size iff.read size -
  137.             IF ." ANIM.DUMP.CHUNK - Truncated CMAP chunk!" cr
  138.             THEN
  139.             
  140.             size 3 / 0
  141.             DO
  142.                 i 8 .r space
  143.                 base @ >r hex
  144.                 i 3 * dif-pad +
  145.                 dup c@ 3 .r 1+
  146.                 dup c@ 3 .r 1+
  147.                 c@ 3 .r cr
  148.                 r> base !
  149.                 ?stop IF iff-stop on LEAVE THEN
  150.             LOOP
  151.         ENDOF
  152.         'GRAB'
  153.         OF
  154.             dif-pad size iff.read 4 -
  155.             IF ." Oddly sized GRAB" cr
  156.             THEN
  157.             ." X = " dif-pad w@ .hex
  158.             ." , Y = " dif-pad 2+ w@ .hex cr
  159.         ENDOF
  160.         'CAMG'
  161.         OF
  162.             dif-pad size iff.read 4 -
  163.             IF ." Oddly sized CAMG" cr
  164.             THEN
  165.             dif-pad @ .hex cr
  166.         ENDOF
  167.         'ANHD'
  168.         OF
  169.             dif-pad size iff.read sizeof() ANHD -
  170.             IF ." ANIM.DUMP.CHUNK - Oddly sized ANHD" cr
  171.             THEN
  172.             dif-pad dump.ANHD
  173.         ENDOF
  174.         'DPAN'
  175.         OF
  176.             dif-pad size iff.read sizeof() DPAN -
  177.             IF ." ANIM.DUMP.CHUNK - Oddly sized DPAN" cr
  178.             THEN
  179.             dif-pad dump.DPAN
  180.         ENDOF
  181.         'DLTA'
  182.         OF
  183.             size chunkid dif.dump.data
  184.             1 dif-dlta-count +!
  185.         ENDOF
  186. \
  187. \ default handling
  188.         size chunkid dif.dump.data
  189.     ENDCASE
  190.     ?stop IF iff-stop on THEN
  191. ;
  192.  
  193. : ANIM.PRINT.CHUNK  { size chunkid -- }
  194. \ indent
  195.     iff-stop @ 0=
  196.     IF
  197.         >newline
  198.         ascii - 40 emit-to-column cr
  199.         iff-nested @ 5 * spaces    chunkid .chkid space size . cr
  200.         size chunkid iff.special? not
  201.         IF
  202.             size chunkid anim.dump.chunk
  203.         THEN
  204.     THEN
  205. ;
  206.  
  207. : DIF.STATS ( -- )
  208.     ascii - 40 emit-to-column cr
  209.     ." File contains:" cr
  210.     dif-body-count @ 8 .r ."  BODY chunks" cr
  211.     dif-dlta-count @ 8 .r ."  DLTA chunks" cr
  212. ;
  213.  
  214. : $DUMPIFF ( $filename -- , print chunks )
  215.     >newline
  216.     ." DumpIFF V1.0 by Phil Burk, written in JForth." cr
  217.     ." DumpIFF may be freely redistributed." cr
  218.     0 dif-body-count !
  219.     0 dif-dlta-count !
  220. \
  221.     what's iff.process.chunk >r
  222.     ' anim.print.chunk is iff.process.chunk
  223.     $iff.dofile?
  224.     IF
  225.         ." Error encountered!" cr
  226.     ELSE
  227.         dif.stats
  228.     THEN
  229.     r> is iff.process.chunk
  230. ;
  231.  
  232. : DUMPIFF ( <filename> -- , print chunks )
  233.     fileword $DUMPIFF
  234. ;
  235.  
  236. cr
  237. ." Enter:   DUMPIFF filename" cr
  238. ." to see contents." cr
  239.